home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / boi.exe / GETCMBBS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-11  |  49KB  |  1,025 lines
  1. {$D-}  { Disable Debug Information }
  2. {$S-}  { Disable Stack Checking }
  3. {$V-}  { Disable String Checking }
  4.  
  5. Unit GetCmBBS;
  6. { Part of BBS Onliner Interface }
  7. { Copyright (C) 1990 Andrew J. Mead
  8.   All Rights Reserved. }
  9.  
  10. { Original version 7/1/90 }
  11. { Original release version 9/5/90 }
  12. { Original public release 12/15/90 }
  13. { history found in IOLIB.PAS }
  14.  
  15.  
  16. INTERFACE
  17.  
  18. Uses
  19.   boidecl,
  20.   DOS;
  21.  
  22. Procedure GETCOMMAND(       { process command line parameters }
  23.     infofile,               { name of documentation file }
  24.     inhof,                  { default name for text hall of fame }
  25.     logfile    : pathstr;   { name of error log }
  26.     gamename,               { name of current game }
  27.     version    : string;    { version of current game }
  28.     programset : charset);  { set of program's command line switches }
  29.  
  30. IMPLEMENTATION
  31.  
  32. Uses
  33.   iolib;
  34.  
  35. Type
  36.   IRQtype   = array [0..15] of byte;   { array of IRQ information }
  37.   portype   = array [0..3] of word;    { default port addressess  }
  38.  
  39. Var
  40.   inchar    : char;                    { standard input character }
  41.   minmax    : byte;                    { maximum time allowed }
  42.  
  43. Const
  44.   timedone  : boolean = false; { remaining time figured }
  45.   filedone  : boolean = false; { BBS file processed }
  46.   hofdone   : boolean = false; { /y processed }
  47.   lockcomm  : boolean = false; { /c processed }
  48.   lockIRQ   : boolean = false; { /i processed }
  49.   locklocal : boolean = false; { /l processed }
  50.   lockname  : boolean = false; { /n processed }
  51.   setlocal  : boolean = false; { BBS file says it is in local play }
  52.   portarray : portype =        { default port addressess for Com1 - Com4 }
  53.       ($3F8,$2F8,$3E8,$2E8);
  54.   IRQarray  : IRQtype =        { interrupt vectors for IRQs 0 - 15 }
  55.       ($08,$09,$0A,$0B,$0C,$0D,$0E,$0F,$70,$71,$72,$73,$74,$75,$76,$77);
  56.   Initarray : IRQtype =        { 8259A IRQ enabling masks-used in Async.Pas }
  57.       ($FE,$FD,$FB,$F7,$EF,$DF,$BF,$7F,$FB,$FB,$FB,$FB,$FB,$FB,$FB,$FB);
  58.       { Entries 8-15 are unknown the cascade mask (for IRQ2) is used }
  59.  
  60.   IRQnum    : byte    = 4;     { default IRQ - Com1 Com3 }
  61.  
  62. Procedure GETCOMMAND;
  63.   var
  64.     gcf         : text;        { user information text file handle }
  65.     gcb         : file;        { user information byte file handle }
  66.     gbuffer     : array [1..4096] of char; { buffer for gcf-text file buffer }
  67.     gcbuffer    : array [0..4095] of byte; { buffer for gcb-binary file buffer}
  68.     gcstr       : string;      { current input line from gcf }
  69.     insize      : word;        { size of gcb }
  70.     dummy       : word;        { Val conversion error value }
  71.     timetemp    : real;        { Second/Minute time conversion variable }
  72.     opchs       : string [2];  { Opus-CBCS Task Designation }
  73.     gloop       : byte;
  74.  
  75.   Procedure SHOWERROR(param : byte;passtr : string);
  76.   { display error in command line arguments }
  77.     var s : text;              { errorlog file handle }
  78.  
  79.     Procedure WRITEERROR(outstr : string);
  80.       begin {* GetCommand,ShowError,WriteError *}
  81.         write(s,'Abnormal termination of program at');
  82.         GetTime(hour,minute,second,hunsec);
  83. {time}  write(s,hour:1,':',minute:1,':',second:1,'  ');
  84.         GetDate(hour,minute,second,hunsec);
  85. {date}  writeln(s,minute:1,'/',second:1,'/',hour:1,'.');
  86.         writeln(s,'ERROR ',param:0);
  87.         writeln(outstr);
  88.         writeln(s,outstr);
  89.         writeln(s)
  90.       end;  {* GetCommand,ShowError,WriteError *}
  91.  
  92.     begin  {* GetCommand,ShowError *}
  93.       write(#27'[2J');
  94.       assign(s,logfile);
  95.       if exist(logfile) then append(s) else rewrite(s);
  96.       writeln(gamename,' version ',version,'.');
  97.       writeln('Copyright (C) 1990 Andrew J. Mead');
  98.       writeln('All Rights Reserved.');
  99.       writeln('Contact: POB 1155 Chapel Hill, NC 27514-1155');
  100.       writeln;
  101.       writeln('Abnormal termination of program:');
  102.       writeln;
  103.       writeln('ERROR ',param:0);
  104.       case param of
  105.            1 : WriteError('Too many command line arguments.');
  106.            2 : WriteError('Unknown or incorrect argument on command line.');
  107.            3 : WriteError(passtr+' file format not supported yet.');
  108.            4 : WriteError('Unable to find '+passtr+'.  Check implementation or notify Sysop.');
  109.            5 : WriteError('Error in '+passtr+'.  Check implementation.');
  110.            7 : WriteError('Duplicate directives.');
  111.            8 : WriteError('Path/Filename for Hall of Fame is not valid.');
  112.            9 : WriteError(passtr+' is not a valid path.');
  113.           10 : WriteError('Invalid port setting(s) in '+passtr+'.');
  114.           11 : WriteError('Invalid or missing numeric in /X:nn.');
  115.           12 : WriteError('Hall of Fame limit out of range, must be in 1-19.');
  116.           13 : WriteError('Invalid or missing value in /C:n.  ''n'' should be 1-4');
  117.           16 : WriteError('/L can not be used with either /C or /I');
  118.           17 : WriteError('Invalid format in /I:i:nnnn.');
  119.           18 : WriteError(passtr+' is not a valid Hexadecimal address in /I statement.');
  120.           19 : WriteError('Invalid numeric in /A:x.');
  121.           20 : WriteError('/A timeleft should be at least 5.');
  122.           21 : WriteError('Error reading data file, check documentation for proper switch.')
  123.         end;
  124.       writeln;
  125.       writeln('Check ',infofile,' for proper installation of this program.');
  126.       writeln('Report error message to SysOp.');
  127.       writeln;
  128.       writeln('Error saved in ',logfile,'.');
  129.       delay(5000);
  130.       writeln('Now returning to BBS.');
  131.       close(s);
  132.       halt
  133.     end;  {* GetCommand,ShowError *}
  134.  
  135.   Procedure PROCESSTEXT(      { process BBS system text file for user info }
  136.       filestr   : pathstr;    { name of BBS system file }
  137.       getname,                { username is in file indicator }
  138.       getime,                 { user time remaining is in file indicator }
  139.       getlines,               { user screen length is in file indicator }
  140.       ismins    : boolean;    { user time remaining is in minutes indicator }
  141.       nameline,               { line at which users name is found }
  142.       timeline,               { line at which users time remaining is found }
  143.       lineline,               { line at which users screen length is found }
  144.       comline,                { line at which the comport is listed }
  145.       combyte,                { byte in comline that determines comport }
  146.       doextra   : byte);      { extra information for a given file - switch }
  147.  
  148.     Procedure RESTART(readline : byte);
  149.     { places the given lines information in gcstring }
  150.       var rloop : byte;
  151.  
  152.       begin {* GetCommand,ProcessText,Restart *}
  153.         reset(gcf);
  154.         {$I-}
  155.         for rloop := 1 to readline do readln(gcf,gcstr);
  156.         {$I+}
  157.         if IOResult <> 0 then ShowError(5,filestr)
  158.       end;  {* GetCommand,ProcessText,Restart *}
  159.  
  160.     Procedure DORBBS;
  161.     { get users last name, and append it to the first name }
  162.       begin {* GetCommand,ProcessText,DoRBBS *}
  163.         Restart(8); { Get user's last name }
  164.         username := username + ' ' + gcstr
  165.       end;  {* GetCommand,ProcessText,DoRBBS *}
  166.  
  167.     Procedure DOWWIV;
  168.     { check to see if game is being played locally or from remote }
  169.     { get user's real name }
  170.       begin {* GetCommand,ProcessText,DoWWIV *}
  171.         Restart(15);
  172.         while (gcstr[1] = ' ') and (length(gcstr) > 0) do delete(gcstr,1,1);
  173.         if (length(gcstr) > 0) and (gcstr[1] = '0') then setlocal := true;
  174.         Restart(3);
  175.         usereal := true;
  176.         realname := gcstr;
  177.         Restart(1);
  178.         realname := '#'+ gcstr + ' ' + realname
  179.       end;  {* GetCommand,ProcessText,DoWWIV *}
  180.  
  181.     Procedure DOSPITFIRE;
  182.     { get user's user number }
  183.       begin {* GetCommand,ProcessText,DoSpitfire *}
  184.         Restart(1);
  185.         usereal := true;
  186.         realname := '#' + gcstr
  187.       end;  {* GetCommand,ProcessText,DoSpitfire *}
  188.  
  189.     Procedure DOWILDCAT;
  190.     { check to see if game is being played locally or from remote }
  191.       begin {* GetCommand,ProcessText,DoWildCat *}
  192.         Restart(28);
  193.         if Pos('LOCAL',gcstr) > 0 then s